R Markdown

Задание 1

library(readr)
library(plotly)
## Loading required package: ggplot2
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(ggplot2)
library(rstatix)
## 
## Attaching package: 'rstatix'
## The following object is masked from 'package:stats':
## 
##     filter
library(reshape2)
library(corrplot)
## corrplot 0.92 loaded
library(pheatmap)
library(stats)
library(gridExtra)
library(umap)

life_expectancy_data <- read_rds("/Users/juliat/Downloads/life_expectancy_data.RDS.rds.rds")

Задание 2

# 'Life expectancy' vs 'GDP'
p <- plot_ly(data = life_expectancy_data, x = ~GDP, y = ~`Life expectancy`, 
             type = 'scatter', mode = 'markers', 
             color = ~continent, marker = list(size = 10))
p

Задание 3

# Фильтр данных для стран Африки и Америки
africa_america_data <- life_expectancy_data[life_expectancy_data$continent %in% c("Africa", "Americas"),]

# t-test
test_result <- t_test(`Life expectancy` ~ continent, data = africa_america_data)

# p-value
p_value <- test_result$p
p_value
## [1] 1.31e-20
# Визуализация ggplot2 + rstatix
ggplot(africa_america_data, aes(x = continent, y = `Life expectancy`, fill = continent)) +
  geom_boxplot() +
  geom_jitter(width = 0.2, size = 2, alpha = 0.5) +
  annotate("text", x = 1.5, y = max(africa_america_data$`Life expectancy`), 
           label = paste("p-value:", round(p_value, 3)), size = 5) +
  theme_minimal() +
  labs(title = "Life Expectancy Comparison: Africa vs America", y = "Life Expectancy", x = "Continent")

Задание 4

# Конвертация data.table в data.frame
life_expectancy_df <- as.data.frame(life_expectancy_data)

# Выбор только числовых столбцов и исключение 'Year'
numeric_data <- life_expectancy_df[sapply(life_expectancy_df, is.numeric)]
numeric_data$Year <- NULL  # исключение 'Year'

# Расчет корреляционной матрицы
cor_matrix <- cor(numeric_data, use = "complete.obs") 

# Корреляционная матрица для ggplot
melted_cor_matrix <- melt(cor_matrix)

# Создание heatmap
ggplot(melted_cor_matrix, aes(Var1, Var2, fill = value)) +
  geom_tile() +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(fill = "Correlation")

# Создание correlogram
corrplot(cor_matrix, method = "circle")

Задание 5

# Вычисление матрицы расстояний, используя евклидово расстояние
dist_matrix <- dist(numeric_data, method = "euclidean")
# Иерархическая кластеризация
hc <- hclust(dist_matrix, method = "complete")
# Построение дендрограммы
plot(hc)

Задание 6

# Создание heatmap с иерархической кластеризацией
pheatmap(numeric_data, 
         scale = "row",   
         clustering_distance_rows = "euclidean",
         clustering_distance_cols = "euclidean",
         clustering_method = "complete")

# Кластеры в строках: Дендрограмма в левой части тепловой карты объединяет сходные наблюдения. Если строки представляют разные страны или организации, то страны, расположенные ближе друг к другу на дендрограмме, имеют более схожие профили по всем измеряемым показателям.
# Кластеры в столбцах: Дендрограмма в верхней части объединяет схожие показатели. Например, GDP и GNI расположены близко друг к другу, что говорит о том, что они имеют схожую структуру по всем наблюдениям. Это вполне ожидаемо, поскольку GDP и GNI являются экономическими показателями, которые часто движутся вместе.
# Цвета тепловой карты: Цвета на тепловой карте соответствуют масштабированным значениям показателей. В данном случае, поскольку строки масштабированы , цвета показывают, как значение каждого показателя для данного наблюдения сопоставляется со средним значением для данного показателя. Темно-красный цвет указывает на значения, значительно превышающие среднее значение, а темно-синий - на значения, значительно ниже среднего.
# Показатели, которые постоянно имеют темно-красный цвет во многих наблюдениях, могут быть выше среднего значения в данном наборе данных, что указывает на потенциальные области, требующие внимания или внимания.
# Показатели, постоянно окрашенные в темно-синий цвет, могут выделять области, в которых результаты наблюдений в целом ниже среднего, что может свидетельствовать об областях, требующих улучшения или вызывающих озабоченность.
# Кластеры показателей или наблюдений могут выявить закономерности, требующие дальнейшего изучения. Например, кластер показателей, связанных со здоровьем, может указывать на группу стран со схожими результатами в области здравоохранения.

Задание 7

# Выполнить РСА 
pca_result <- prcomp(numeric_data, center = TRUE, scale. = TRUE)

# Сводка результатов PCA
summary(pca_result)
## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6    PC7
## Standard deviation     2.7526 1.4841 1.3952 1.17177 1.08375 0.96347 0.9288
## Proportion of Variance 0.3988 0.1159 0.1025 0.07227 0.06182 0.04886 0.0454
## Cumulative Proportion  0.3988 0.5147 0.6172 0.68945 0.75126 0.80012 0.8455
##                            PC8     PC9    PC10    PC11    PC12    PC13    PC14
## Standard deviation     0.85740 0.69263 0.68937 0.59106 0.54986 0.47085 0.36596
## Proportion of Variance 0.03869 0.02525 0.02501 0.01839 0.01591 0.01167 0.00705
## Cumulative Proportion  0.88421 0.90946 0.93447 0.95286 0.96877 0.98044 0.98749
##                           PC15    PC16    PC17    PC18      PC19
## Standard deviation     0.34546 0.26941 0.20224 0.06968 1.017e-15
## Proportion of Variance 0.00628 0.00382 0.00215 0.00026 0.000e+00
## Cumulative Proportion  0.99377 0.99759 0.99974 1.00000 1.000e+00
# Построение графика дисперсии
plot(pca_result, type = "l")

# Извлечение оценок (координат главных компонент)
scores <- as.data.frame(pca_result$x)

# ggplot первых двух главных компонент
ggplot(scores, aes(PC1, PC2)) +
  geom_point() +
  xlab(paste("PC1 - ", round(summary(pca_result)$importance[2,1]*100, 1), "%")) +
  ylab(paste("PC2 - ", round(summary(pca_result)$importance[2,2]*100, 1), "%")) +
  theme_minimal()

Задание 8

# Вывести названия столбцов набора данных
print(colnames(life_expectancy_data))
##  [1] "Country"                                
##  [2] "Year"                                   
##  [3] "Gender"                                 
##  [4] "Life expectancy"                        
##  [5] "Unemployment"                           
##  [6] "Infant Mortality"                       
##  [7] "GDP"                                    
##  [8] "GNI"                                    
##  [9] "Clean fuels and cooking technologies"   
## [10] "Per Capita"                             
## [11] "Mortality caused by road traffic injury"
## [12] "Tuberculosis Incidence"                 
## [13] "DPT Immunization"                       
## [14] "HepB3 Immunization"                     
## [15] "Measles Immunization"                   
## [16] "Hospital beds"                          
## [17] "Basic sanitation services"              
## [18] "Tuberculosis treatment"                 
## [19] "Urban population"                       
## [20] "Rural population"                       
## [21] "Non-communicable Mortality"             
## [22] "Sucide Rate"                            
## [23] "continent"
# Добавить оценки PCA к исходному массиву данны
biplot_data <- cbind(life_expectancy_data, PCA1 = pca_result$x[,1], PCA2 = pca_result$x[,2])

# Создание интерактивного biplot
p <- plot_ly(data = biplot_data, x = ~PCA1, y = ~PCA2, type = 'scatter', mode = 'markers',
             text = ~Country, color = ~continent, colors = 'Set1',
             marker = list(size = 10, opacity = 0.5)) %>%
      layout(title = 'PCA Biplot',
             xaxis = list(title = 'PC1'),
             yaxis = list(title = 'PC2'))

# Вывести график
p

Задание 9

# Задание 7: Интерпретация результатов РСА-анализа
# Результаты PCA-анализа показывают, что первая главная компонента (PC1) объясняет около 39,88% дисперсии данных, а вторая главная компонента (PC2) - около 11,59%. В совокупности первые две компоненты объясняют более 51,47% дисперсии. Это значительная величина, но она также указывает на то, что в данных есть и другие факторы и измерения, которые вносят вклад в оставшуюся дисперсию.
# Представленная диаграмма распределения отображает дисперсии главных компонент, имея типичную форму "локтя", указывающую на то, что первые несколько компонент объясняют наиболее значительную дисперсию, а последующие компоненты вносят меньший вклад. При принятии решения о том, сколько компонентов оставить, обычно учитывается место расположения этого локтя, предполагая, что компоненты, расположенные за этой точкой, вносят меньший вклад в объяснение дисперсии и могут рассматриваться как шум.
# На биплоте показано, как различные страны (представленные точками) отображаются на первые две главные компоненты. Цветовое кодирование по континентам указывает на возможную кластеризацию по континентам. Например, страны одного и того же континента могут объединяться в кластеры, что говорит о сходстве ожидаемой продолжительности жизни и других переменных, включенных в PCA.
# Задание 8: Интерпретация биплота PCA
# biplot PCA объединяет в себе диаграмму рассеяния оценок первых двух главных компонент с векторами, представляющими нагрузки каждой переменной, которые не видны на общем изображении биплограммы. 
# Интерпретация результатов PCA и биплота
# Результаты PCA свидетельствуют о том, что ВВП, показатели здоровья и другие социально-экономические факторы действительно влияют на продолжительность жизни, но делают это сложными способами, которые не могут быть полностью отражены только географическим положением. Кластеризация точек по континентам свидетельствует о сходстве регионов, однако их перекрытие указывает на сложное взаимодействие различных факторов, влияющих на продолжительность жизни.
# В целом, PCA показывает, что существует несколько ключевых измерений, по которым данные различаются наиболее существенно, и эти измерения, скорее всего, связаны с сочетанием экономических, медицинских и социальных факторов.

Задание 10

# Выполнение UMAP
umap_result <- umap(numeric_data)
umap_data <- as.data.frame(umap_result$layout)
colnames(umap_data) <- c("UMAP1", "UMAP2")
# Визуализация с использованием ggplot2
ggplot(umap_data, aes(UMAP1, UMAP2)) + 
  geom_point() +
  theme_minimal() +
  labs(title = "UMAP Projection")

# Выполнение PCA
pca_result <- prcomp(numeric_data, center = TRUE, scale. = TRUE)
scores <- as.data.frame(pca_result$x)
# Визуализация с использованием ggplot2
ggplot(scores, aes(PC1, PC2)) +
  geom_point() +
  theme_minimal() +
  labs(title = "PCA Projection")

# Распределение точек:
# PCA: Точки в проекции PCA распределяются более равномерно по всему пространству. Это свидетельствует о том, что PCA сохраняет глобальную структуру данных и различия между точками в исходном пространстве.
# UMAP: Точки в проекции UMAP формируют несколько четко различимых кластеров. Это указывает на то, что UMAP лучше отражает локальные структуры и возможно подчеркивает более тонкие группировки в данных.
# Сохранение структуры данных:
# PCA: Как линейный метод, PCA стремится сохранить дистанцию и направление максимальной дисперсии, что может привести к менее очевидной кластеризации, если данные имеют сложную или нелинейную структуру.
# UMAP: UMAP, используя нелинейный подход, часто лучше отображает структуру данных, когда важны локальные отношения, что может быть более информативным для определенных видов анализа данных.
# Интерпретация:
# PCA: Интерпретация PCA может быть более прямолинейной, так как она отражает основные направления вариативности в данных.
# UMAP: Интерпретация результатов UMAP может потребовать более глубокого понимания структуры данных и способа формирования кластеров, так как метод может выявлять сложные нелинейные зависимости.
# Выбор метода:
# Выбор между PCA и UMAP может зависеть от целей анализа. Для понимания глобальных отношений и основных направлений дисперсии, PCA может быть предпочтительнее. Если же важнее выявить скрытые локальные шаблоны или кластеры, UMAP может быть предпочтительнее.

Задание 11

set.seed(123) # For reproducibility
random_cols <- sample(names(numeric_data), 5)
reduced_data <- numeric_data[ , !(names(numeric_data) %in% random_cols)]

pca_reduced <- prcomp(reduced_data, scale = TRUE)
summary(pca_reduced)
## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5    PC6     PC7
## Standard deviation     2.3562 1.3934 1.2683 1.15126 0.95368 0.8807 0.71828
## Proportion of Variance 0.3966 0.1387 0.1149 0.09467 0.06496 0.0554 0.03685
## Cumulative Proportion  0.3966 0.5352 0.6501 0.74480 0.80977 0.8652 0.90202
##                            PC8     PC9    PC10    PC11    PC12    PC13
## Standard deviation     0.68711 0.58741 0.50867 0.41594 0.34317 0.07115
## Proportion of Variance 0.03372 0.02465 0.01848 0.01236 0.00841 0.00036
## Cumulative Proportion  0.93574 0.96039 0.97887 0.99123 0.99964 1.00000
##                             PC14
## Standard deviation     4.382e-16
## Proportion of Variance 0.000e+00
## Cumulative Proportion  1.000e+00
library(stats)

# Function to perform PCA after dropping 5 random columns
perform_pca <- function(data, seed) {
  set.seed(seed)  # Set seed for reproducibility
  cols_to_remove <- sample(colnames(data), 5)  # Randomly select 5 columns
  data_reduced <- data[, !(colnames(data) %in% cols_to_remove)]  # Drop the columns
  pca_result <- prcomp(data_reduced, center = TRUE, scale. = TRUE)  # Perform PCA
  summary(pca_result)  # Summarize the PCA results
}

# Perform PCA three times with different random columns removed
pca1 <- perform_pca(numeric_data, seed = 1)
pca2 <- perform_pca(numeric_data, seed = 2)
pca3 <- perform_pca(numeric_data, seed = 3)

# Print the summaries to compare the results
print(pca1)
## Importance of components:
##                          PC1    PC2     PC3     PC4     PC5     PC6    PC7
## Standard deviation     2.485 1.4284 1.10309 1.01042 0.96005 0.88666 0.7474
## Proportion of Variance 0.441 0.1457 0.08691 0.07292 0.06584 0.05615 0.0399
## Cumulative Proportion  0.441 0.5868 0.67369 0.74662 0.81245 0.86860 0.9085
##                            PC8    PC9    PC10    PC11    PC12    PC13  PC14
## Standard deviation     0.65115 0.6057 0.43186 0.37345 0.34846 0.20658 4e-16
## Proportion of Variance 0.03029 0.0262 0.01332 0.00996 0.00867 0.00305 0e+00
## Cumulative Proportion  0.93879 0.9650 0.97832 0.98828 0.99695 1.00000 1e+00
print(pca2)
## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.3333 1.4317 1.2974 1.09192 1.02227 0.88764 0.75953
## Proportion of Variance 0.3889 0.1464 0.1202 0.08516 0.07464 0.05628 0.04121
## Cumulative Proportion  0.3889 0.5353 0.6555 0.74065 0.81530 0.87158 0.91278
##                            PC8     PC9   PC10    PC11    PC12    PC13    PC14
## Standard deviation     0.64742 0.59422 0.4364 0.35741 0.29076 0.20275 0.07051
## Proportion of Variance 0.02994 0.02522 0.0136 0.00912 0.00604 0.00294 0.00036
## Cumulative Proportion  0.94272 0.96794 0.9816 0.99067 0.99671 0.99964 1.00000
print(pca3)
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.5338 1.2188 1.14423 0.97404 0.93398 0.82869 0.81703
## Proportion of Variance 0.4586 0.1061 0.09352 0.06777 0.06231 0.04905 0.04768
## Cumulative Proportion  0.4586 0.5647 0.65820 0.72597 0.78828 0.83733 0.88501
##                            PC8     PC9    PC10    PC11    PC12    PC13
## Standard deviation     0.68906 0.62750 0.54555 0.46948 0.37063 0.29308
## Proportion of Variance 0.03391 0.02813 0.02126 0.01574 0.00981 0.00614
## Cumulative Proportion  0.91892 0.94705 0.96831 0.98405 0.99386 1.00000
##                             PC14
## Standard deviation     3.204e-16
## Proportion of Variance 0.000e+00
## Cumulative Proportion  1.000e+00
# Видно, что на каждой итерации PCA наблюдается изменение объясненной дисперсии. Хотя суммарная дисперсия, объясненная компонентами, остается близкой к 1 (или 100%), распределение по отдельным компонентам меняется. Например: доля дисперсии, объясненной первой главной компонентой (PC1), в разных итерациях изменяется от примерно 39% до более чем 45%.
# Суммарная дисперсия, объясненная первыми двумя компонентами, колеблется от 54% до 58%. Эти изменения обусловлены тем, что каждый раз удаляются различные признаки, что приводит к изменению базовой структуры данных, которую отражает PCA. Каждый набор признаков вносит свой вклад в общую дисперсию, и их удаление может перераспределить долю дисперсии, объясняемую каждой главной компонентой.
# Этот эксперимент иллюстрирует чувствительность PCA к конкретному набору признаков, включенных в анализ. Поскольку PCA опирается на дисперсию признаков, удаление различных признаков может существенно повлиять на результаты. Именно поэтому PCA, как и снижение размерности в целом, можно считать несколько нестабильным или чувствительным к изменениям исходных данных.

Задание 12

numeric_data$africa <- ifelse(life_expectancy_data$continent == "Africa", 1, 0)
numeric_data$oceanic <- ifelse(life_expectancy_data$continent == "Oceania", 1, 0)

pca_dummy <- prcomp(numeric_data[, c("africa", "oceanic")], scale = TRUE)

library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
fviz_pca_ind(pca_dummy)

# График представляет собой biplot PCA с двумя измерениями, обозначенными как Dim1 и Dim2, которые, представляют собой первые две главные компоненты. Проценты в метках (58,7% для Dim1 и 41,3% для Dim2) указывают на количество дисперсии, которую каждая главная компонента улавливает из набора данных. Вместе они отражают 100% дисперсии, поскольку в PCA включены только две фиктивные переменные ("Африка" и "Океания"), что позволяет свести данные только к двум измерениям.
# biplot PCA обычно показывает как баллы (преобразованные координаты исходных точек данных в пространстве главных компонент), так и нагрузки (коэффициенты исходных переменных). Однако, поскольку были использованы только фиктивные переменные, biplot не дает возможности для интерпретации, поскольку фиктивные переменные обычно принимают бинарные значения (0 или 1), и их использование в PCA может быть проблематичным.
# Кроме того, PCA - это метод, основанный на непрерывных переменных и предполагающий линейную зависимость между ними. Бинарные переменные, особенно неравномерно распределенные (например, редко встречающаяся "Океания" по сравнению с "Африкой"), могут исказить результаты PCA и сделать интерпретацию главных компонент менее понятной.
# Таким образом, проведенный PCA с фиктивными переменными для континентов отражает всю дисперсию бинарных данных, но не позволяет получить значимое представление о структуре данных, как это было бы при применении традиционного PCA к непрерывным переменным.